home *** CD-ROM | disk | FTP | other *** search
/ Power CD / Power CD ATARI-Rechner Lieben.iso / GAMES / PD / WUERFEL / WUERFEL.GFA (.txt) next >
Encoding:
GFA-BASIC Atari  |  1992-06-27  |  10.7 KB  |  474 lines
  1. ' *****************************************************************************
  2. ' *                                                                           *
  3. ' *         Das ultimative Würfel-Programm von Wolfgang Schneider             *
  4. ' *                                                                           *
  5. ' *****************************************************************************
  6. $m10000
  7. $s&,s>
  8. IF XBIOS(4)=2
  9.   MOUSE mausx&,mausy&,k#
  10.   HIDEM
  11.   version$="Version 1.0, 27.06.1992"
  12.   init
  13.   main
  14.   SETMOUSE mausx&,mausy&
  15.   SHOWM
  16. ELSE
  17.   pling
  18.   ALERT 3,"|Sorry, WÜRFELN nur im|640*400 Punkte Modus!",1,"Schade!",k#
  19. ENDIF
  20. EDIT
  21. '
  22. > PROCEDURE init
  23.   OPTION BASE 1
  24.   anz|=1
  25.   anzahl%=0
  26.   RANDOMIZE
  27.   DIM statistik%(6),x&(5),pasch|(6),y&(3,6),xxx&(3,3),yyy&(3,3),gr|(3)
  28.   gr|(1)=15
  29.   gr|(2)=12
  30.   gr|(3)=10
  31.   y&(1,1)=160
  32.   y&(1,2)=400
  33.   y&(1,3)=245
  34.   y&(1,4)=125
  35.   y&(1,5)=395
  36.   y&(1,6)=275
  37.   y&(2,1)=128
  38.   y&(2,2)=384
  39.   y&(2,3)=260
  40.   y&(2,4)=140
  41.   y&(2,5)=380
  42.   y&(2,6)=260
  43.   y&(3,1)=106
  44.   y&(3,2)=371
  45.   y&(3,3)=270
  46.   y&(3,4)=150
  47.   y&(3,5)=370
  48.   y&(3,6)=250
  49.   x&(1)=-210
  50.   x&(2)=0
  51.   x&(3)=210
  52.   x&(4)=-120
  53.   x&(5)=120
  54.   xxx&(1,1)=271
  55.   xxx&(1,2)=320
  56.   xxx&(1,3)=369
  57.   yyy&(1,1)=151
  58.   yyy&(1,2)=200
  59.   yyy&(1,3)=249
  60.   xxx&(2,1)=281
  61.   xxx&(2,2)=320
  62.   xxx&(2,3)=359
  63.   yyy&(2,1)=161
  64.   yyy&(2,2)=200
  65.   yyy&(2,3)=239
  66.   xxx&(3,1)=288
  67.   xxx&(3,2)=320
  68.   xxx&(3,3)=352
  69.   yyy&(3,1)=168
  70.   yyy&(3,2)=200
  71.   yyy&(3,3)=232
  72.   first!=TRUE
  73.   raus!=FALSE
  74.   zehn|=10
  75.   zwanzig|=20
  76.   oben$=CHR$(0)+CHR$(72)
  77.   unten$=CHR$(0)+CHR$(80)
  78.   links$=CHR$(0)+CHR$(75)
  79.   rechts$=CHR$(0)+CHR$(77)
  80.   programm!=FALSE
  81.   preret$="Press RETURN"
  82.   ~GRAF_GROWBOX(320,240,0,0,0,0,640,400)
  83. RETURN
  84. > PROCEDURE pling
  85.   SOUND 1,15,10,6
  86.   WAVE 1,1,9,12085
  87. RETURN
  88. > PROCEDURE beep
  89.   SOUND 1,6,1,6,3
  90.   SOUND 1,0,1,5,0
  91. RETURN
  92. > PROCEDURE bild
  93.   GRAPHMODE 1
  94.   RANDOMIZE
  95.   DEFTEXT 1,0,0,6
  96.   DEFFILL 1,2,4
  97.   PBOX 0,0,640,400
  98.   DEFFILL 0,2,8
  99.   DEFTEXT 1,0,0,32
  100.   GRAPHMODE 2
  101.   PRBOX 8,312,62,366
  102.   RBOX 7,311,63,367
  103.   RBOX 8,312,62,366
  104.   RBOX 10,314,60,364
  105.   TEXT 70,352,"<< 10er"
  106.   PRBOX 578,312,632,366
  107.   RBOX 577,311,633,367
  108.   RBOX 578,312,632,366
  109.   RBOX 580,314,630,364
  110.   TEXT 460,352,"20er >>"
  111.   PBOX 10,10,630,91
  112.   BOX 10,10,630,91
  113.   BOX 11,11,629,90
  114.   TEXT 30,40,"Statistiks:"
  115.   DEFTEXT 1,0,0,6
  116.   TEXT 46,50,"(für 6er Würfel)"
  117.   DEFTEXT 1,0,0,13
  118.   TEXT 30,70,"Absolute Anzahl:"
  119.   TEXT 30,86,"Aktuelle Summe :"
  120.   DEFTEXT 1,0,0,6
  121.   FOR i|=1 TO 6
  122.     TEXT 230,ADD(MUL(i|,12),13),STR$(i|)+":"
  123.     TEXT 260,ADD(MUL(i|,12),13),"  0%"
  124.   NEXT i|
  125.   GRAPHMODE 1
  126.   PBOX 200,309,440,370
  127.   BOX 200,309,440,370
  128.   BOX 202,311,438,368
  129.   BOX 203,312,437,367
  130.   tastatur
  131.   DEFTEXT 1,0,0,6
  132.   PBOX 10,375,630,395
  133.   BOX 10,375,630,395
  134.   BOX 11,376,629,394
  135.   TEXT 20,388,600,"Wolfgang Schneider * Von-Ketteler-Str.26 * 5000 Köln 80 * Tel.: 0221/6404043"
  136.   IF first!
  137.     pling
  138.     ~FORM_ALERT(1,"[0]"+"[       Alea iacta est!|~~~~~~~~~~~~~~~~~~~~~~~~~~~~| W Ü R F E L  ist FREEWARE!  |~~~~~~~~~~~~~~~~~~~~~~~~~~~~|Programmiert von W.Schneider  ]"+"[ "+version$+" ]")
  139.     first!=FALSE
  140.   ENDIF
  141.   DEFLINE 1,0,0,0
  142.   LINE 20,359,50,359
  143. RETURN
  144. > PROCEDURE tastatur
  145.   DEFTEXT 1,4,0,6
  146.   TEXT 252,322,"ESC = Programmende"
  147.   TEXT 242,332,"RETURN = Neu würfeln"
  148.   TEXT 213,342,"1 bis 6 = Anzahl 6er Würfel"
  149.   TEXT 220,352,"L = 6er Statistik löschen"
  150.   TEXT 207,362,230,"Cursortasten = ""Programmieren"""
  151. RETURN
  152. > PROCEDURE kreis_start
  153.   DEFFILL 1,2,4
  154.   GRAPHMODE 4
  155.   PRBOX 2,96,638,304
  156.   GRAPHMODE 1
  157.   DEFFILL 0,2,8
  158.   FOR j|=1 TO anz|
  159.     IF anz|<4
  160.       SELECT anz|
  161.       CASE 3
  162.         x&=x&(j|)
  163.       CASE 2
  164.         x&=x&(ADD(3,j|))
  165.       CASE 1
  166.         x&=x&(2)
  167.       ENDSELECT
  168.       PRBOX ADD(x&,218),100,ADD(x&,422),300
  169.       RBOX ADD(x&,218),98,ADD(x&,422),302
  170.       FOR i|=1 TO 3
  171.         RBOX ADD(x&,ADD(220,i|)),ADD(100,i|),ADD(x&,SUB(420,i|)),SUB(300,i|)
  172.       NEXT i|
  173.       DEFTEXT 1,2,0,32
  174.       TEXT ADD(x&,225),211,-191,preret$
  175.     ELSE
  176.       k|=SUB(anz|,3)
  177.       x&=SUB(MUL(j|,y&(k|,1)),y&(k|,2))
  178.       PRBOX ADD(x&,SUB(y&(k|,3),2)),y&(k|,4),ADD(x&,ADD(y&(k|,5),2)),y&(k|,6)
  179.       RBOX ADD(x&,SUB(y&(k|,3),2)),SUB(y&(k|,4),2),ADD(x&,ADD(y&(k|,5),2)),ADD(y&(k|,6),2)
  180.       FOR i|=1 TO 3
  181.         RBOX ADD(x&,ADD(y&(k|,3),i|)),ADD(y&(k|,4),i|),ADD(x&,SUB(y&(k|,5),i|)),SUB(y&(k|,6),i|)
  182.       NEXT i|
  183.       SELECT anz|
  184.       CASE 4
  185.         DEFTEXT 1,2,0,20
  186.         TEXT ADD(x&,252),209,-137,preret$
  187.       CASE 5
  188.         DEFTEXT 1,2,0,13
  189.         TEXT ADD(x&,272),207,preret$
  190.       CASE 6
  191.         DEFTEXT 1,2,0,6
  192.         TEXT ADD(x&,276),204,-89,preret$
  193.       ENDSELECT
  194.     ENDIF
  195.   NEXT j|
  196. RETURN
  197. > PROCEDURE main
  198.   LOCAL new|,i|,k$,tricky|,x_pos&
  199.   bild
  200.   kreis_start
  201.   GOTO label
  202.   REPEAT
  203.     aktuell|=0
  204.     FOR i|=1 TO anz|
  205.       t|=SUCC(RAND(6))
  206.       pasch|(i|)=t|
  207.       aktuell|=ADD(aktuell|,t|)
  208.       SELECT anz|
  209.       CASE 1
  210.         x&=2
  211.       CASE 2
  212.         x&=ADD(i|,3)
  213.       CASE 3,4,5,6
  214.         x&=i|
  215.       ENDSELECT
  216.       kreis(x&,t|,anz|)
  217.     NEXT i|
  218.     statistik
  219.     DEFTEXT 1,0,0,32
  220.     x_er(11,zehn|)
  221.     x_er(581,zwanzig|)
  222.     pasch!=TRUE
  223.     FOR i|=2 TO anz|
  224.       pasch!=AND(pasch!,(pasch|(i|)=pasch|(1)))
  225.       EXIT IF NOT pasch!
  226.     NEXT i|
  227.     IF AND(pasch!,NOT (anz|=1))
  228.       DEFTEXT 1,0,0,32
  229.       DEFFILL 0,2,8
  230.       PBOX 204,313,436,366
  231.       GRAPHMODE 3
  232.       i|=1
  233.       REPEAT
  234.         INC i|
  235.         TEXT 277,351,"PASCH!"
  236.       UNTIL i|>20
  237.       GRAPHMODE 1
  238.       PBOX 204,313,436,366
  239.       tastatur
  240.     ENDIF
  241.     beep
  242.   label:
  243.     REPEAT
  244.       k$=UPPER$(INKEY$)
  245.     UNTIL OR(OR(OR(OR(OR(OR(OR(OR(AND(k$>"0",k$<"7"),k$=CHR$(13)),k$=CHR$(27)),k$="L"),k$="*"),k$=oben$),k$=unten$),k$=links$),k$=rechts$)
  246.     REPEAT
  247.     UNTIL INKEY$=""
  248.     IF AND(k$>"0",k$<"7")
  249.       k|=VAL(k$)
  250.       IF k|<>anz|
  251.         anz|=k|
  252.         IF anz|>3
  253.           k|=SUB(anz|,3)
  254.           xxx1&=xxx&(k|,1)
  255.           xxx2&=xxx&(k|,2)
  256.           xxx3&=xxx&(k|,3)
  257.           yyy1&=yyy&(k|,1)
  258.           yyy2&=yyy&(k|,2)
  259.           yyy3&=yyy&(k|,3)
  260.         ENDIF
  261.         kreis_start
  262.         GOTO label
  263.       ELSE
  264.         GOTO label
  265.       ENDIF
  266.     ELSE IF k$="L"
  267.       ARRAYFILL statistik%(),0
  268.       anzahl%=-anz|
  269.       DEFTEXT 1,0,0,13
  270.       TEXT 168,70,"       "
  271.       statistik
  272.       GOTO label
  273.     ELSE IF k$=oben$
  274.       IF programm!
  275.         ABSOLUTE tricky|,V:zwanzig|
  276.         x_pos&=460
  277.       ELSE
  278.         ABSOLUTE tricky|,V:zehn|
  279.         x_pos&=118
  280.       ENDIF
  281.       new|=MIN(99,SUCC(tricky|))
  282.       GRAPHMODE 2
  283.       DEFTEXT 0,2,0,32
  284.       VSYNC
  285.       TEXT x_pos&,352,RIGHT$(" "+STR$(tricky|),2)
  286.       GRAPHMODE 2
  287.       DEFTEXT 1,0,0,32
  288.       tricky|=new|
  289.       VSYNC
  290.       TEXT x_pos&,352,RIGHT$(" "+STR$(tricky|),2)
  291.       GRAPHMODE 1
  292.       GOTO label
  293.     ELSE IF k$=unten$
  294.       IF programm!
  295.         ABSOLUTE tricky|,V:zwanzig|
  296.         x_pos&=460
  297.       ELSE
  298.         ABSOLUTE tricky|,V:zehn|
  299.         x_pos&=118
  300.       ENDIF
  301.       new|=MAX(2,PRED(tricky|))
  302.       GRAPHMODE 2
  303.       DEFTEXT 0,2,0,32
  304.       VSYNC
  305.       TEXT x_pos&,352,RIGHT$(" "+STR$(tricky|),2)
  306.       GRAPHMODE 2
  307.       DEFTEXT 1,0,0,32
  308.       tricky|=new|
  309.       VSYNC
  310.       TEXT x_pos&,352,RIGHT$(" "+STR$(tricky|),2)
  311.       GRAPHMODE 1
  312.       GOTO label
  313.     ELSE IF k$=links$
  314.       IF programm!
  315.         programm!=FALSE
  316.         GRAPHMODE 3
  317.         LINE 590,359,620,359
  318.         GRAPHMODE 1
  319.         LINE 20,359,50,359
  320.       ENDIF
  321.       GOTO label
  322.     ELSE IF k$=rechts$
  323.       IF NOT programm!
  324.         programm!=TRUE
  325.         GRAPHMODE 3
  326.         LINE 20,359,50,359
  327.         GRAPHMODE 1
  328.         LINE 590,359,620,359
  329.       ENDIF
  330.       GOTO label
  331.     ENDIF
  332.     IF OR(k$=CHR$(27),k$="*")
  333.       raus!=@bye
  334.       IF NOT raus!
  335.         GOTO label
  336.       ENDIF
  337.     ENDIF
  338.   UNTIL raus!
  339.   ~GRAF_SHRINKBOX(320,240,0,0,0,0,640,400)
  340. RETURN
  341. > PROCEDURE x_er(x_pos&,max|)
  342.   LOCAL x&
  343.   x&=SUCC(RAND(max|))
  344.   IF x&<10
  345.     TEXT x_pos&,351," "+STR$(x&)+" "
  346.   ELSE
  347.     TEXT ADD(x_pos&,8),351,STR$(x&)
  348.   ENDIF
  349. RETURN
  350. > PROCEDURE kreis(pos|,wert|,anz|)
  351.   LOCAL x&,i|,k|,gr|
  352.   INC statistik%(wert|)
  353.   DEFFILL 0,2,8
  354.   IF anz|<4
  355.     gr|=22
  356.     x&=x&(pos|)
  357.     PBOX ADD(x&,227),107,ADD(x&,413),293
  358.     DEFFILL 1,2,8
  359.     SELECT wert|
  360.       VSYNC
  361.     CASE 1
  362.       PCIRCLE ADD(x&,320),200,gr|
  363.     CASE 2
  364.       PCIRCLE ADD(x&,255),135,gr|
  365.       PCIRCLE ADD(x&,385),265,gr|
  366.     CASE 3
  367.       PCIRCLE ADD(x&,255),135,gr|
  368.       PCIRCLE ADD(x&,320),200,gr|
  369.       PCIRCLE ADD(x&,385),265,gr|
  370.     CASE 4
  371.       PCIRCLE ADD(x&,255),135,gr|
  372.       PCIRCLE ADD(x&,385),135,gr|
  373.       PCIRCLE ADD(x&,255),265,gr|
  374.       PCIRCLE ADD(x&,385),265,gr|
  375.     CASE 5
  376.       PCIRCLE ADD(x&,255),135,gr|
  377.       PCIRCLE ADD(x&,385),135,gr|
  378.       PCIRCLE ADD(x&,320),200,gr|
  379.       PCIRCLE ADD(x&,255),265,gr|
  380.       PCIRCLE ADD(x&,385),265,gr|
  381.     CASE 6
  382.       PCIRCLE ADD(x&,255),135,gr|
  383.       PCIRCLE ADD(x&,385),135,gr|
  384.       PCIRCLE ADD(x&,255),200,gr|
  385.       PCIRCLE ADD(x&,385),200,gr|
  386.       PCIRCLE ADD(x&,255),265,gr|
  387.       PCIRCLE ADD(x&,385),265,gr|
  388.     ENDSELECT
  389.   ELSE
  390.     k|=SUB(anz|,3)
  391.     gr|=gr|(k|)
  392.     x&=SUB(MUL(pos|,y&(k|,1)),y&(k|,2))
  393.     SELECT anz|
  394.     CASE 4
  395.       PBOX ADD(x&,253),132,ADD(x&,387),268
  396.     CASE 5
  397.       PBOX ADD(x&,267),146,ADD(x&,373),254
  398.     CASE 6
  399.       PBOX ADD(x&,277),156,ADD(x&,363),244
  400.     ENDSELECT
  401.     DEFFILL 1,2,8
  402.     SELECT wert|
  403.       VSYNC
  404.     CASE 1
  405.       PCIRCLE ADD(x&,xxx2&),yyy2&,gr|
  406.     CASE 2
  407.       PCIRCLE ADD(x&,xxx1&),yyy1&,gr|
  408.       PCIRCLE ADD(x&,xxx3&),yyy3&,gr|
  409.     CASE 3
  410.       PCIRCLE ADD(x&,xxx1&),yyy1&,gr|
  411.       PCIRCLE ADD(x&,xxx2&),yyy2&,gr|
  412.       PCIRCLE ADD(x&,xxx3&),yyy3&,gr|
  413.     CASE 4
  414.       PCIRCLE ADD(x&,xxx1&),yyy1&,gr|
  415.       PCIRCLE ADD(x&,xxx3&),yyy1&,gr|
  416.       PCIRCLE ADD(x&,xxx1&),yyy3&,gr|
  417.       PCIRCLE ADD(x&,xxx3&),yyy3&,gr|
  418.     CASE 5
  419.       PCIRCLE ADD(x&,xxx1&),yyy1&,gr|
  420.       PCIRCLE ADD(x&,xxx3&),yyy1&,gr|
  421.       PCIRCLE ADD(x&,xxx2&),yyy2&,gr|
  422.       PCIRCLE ADD(x&,xxx1&),yyy3&,gr|
  423.       PCIRCLE ADD(x&,xxx3&),yyy3&,gr|
  424.     CASE 6
  425.       PCIRCLE ADD(x&,xxx1&),yyy1&,gr|
  426.       PCIRCLE ADD(x&,xxx3&),yyy1&,gr|
  427.       PCIRCLE ADD(x&,xxx1&),yyy2&,gr|
  428.       PCIRCLE ADD(x&,xxx3&),yyy2&,gr|
  429.       PCIRCLE ADD(x&,xxx1&),yyy3&,gr|
  430.       PCIRCLE ADD(x&,xxx3&),yyy3&,gr|
  431.     ENDSELECT
  432.   ENDIF
  433. RETURN
  434. > FUNCTION bye
  435.   REPEAT
  436.   UNTIL MOUSEK=0
  437.   pling
  438.   IF FORM_ALERT(2,"[0][  Programm beenden ?][Wirklich|Unwirklich]")=1
  439.     raus!=TRUE
  440.   ELSE
  441.     raus!=FALSE
  442.   ENDIF
  443.   HIDEM
  444.   RETURN raus!
  445. ENDFUNC
  446. > PROCEDURE statistik
  447.   LOCAL max%,summe%,i|,dummy|,dummy&
  448.   summe%=0
  449.   max%=0
  450.   DEFTEXT 1,0,0,6
  451.   FOR i|=1 TO 6
  452.     max%=MAX(max%,statistik%(i|))
  453.     summe%=ADD(summe%,statistik%(i|))
  454.   NEXT i|
  455.   dummy|=LEN(STR$(max%))
  456.   IF MUL(max%,summe%)=0
  457.     max%=1000
  458.     summe%=1000
  459.   ENDIF
  460.   FOR i|=1 TO 6
  461.     TEXT 260,ADD(MUL(i|,12),13),RIGHT$("  "+STR$(ROUND(MUL(100,statistik%(i|))/summe%)),3)
  462.     DEFFILL 0,2,8
  463.     PBOX 300,ADD(MUL(i|,12),5),620,ADD(MUL(i|,12),14)
  464.     DEFFILL 1,2,SUCC(i|)
  465.     dummy&=MUL(dummy|,8)
  466.     PBOX 300,ADD(MUL(i|,12),5),ADD(300,MUL(ROUND(SUB(316,dummy&)),(statistik%(i|)))/max%),ADD(MUL(i|,12),14)
  467.     TEXT SUB(622,dummy&),ADD(MUL(i|,12),13),RIGHT$(SPACE$(dummy|)+STR$(statistik%(i|)),dummy|)
  468.   NEXT i|
  469.   anzahl%=ADD(anzahl%,anz|)
  470.   DEFTEXT 1,0,0,13
  471.   TEXT 168,70,anzahl%
  472.   TEXT 168,86,STR$(aktuell|)+" "
  473. RETURN
  474.